home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
st80_pr4.lha
/
st80_pre4
/
Foible
/
foible
/
Foible4.st
< prev
next >
Wrap
Text File
|
1993-07-24
|
97KB
|
3,780 lines
'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 19 May 1990 at 1:55:55 pm'!
MouseMenuController subclass: #CanvasController
instanceVariableNames: 'tool saveCursor redButtonResult lastYellowButtonMessage '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
CanvasController comment:
'I am the controller for a single canvas.
Instance variables:
tool <Tool>
saveCursor <Cursor>
redButtonResult ?
lastYellowButtonMessage <Symbol>'!
!CanvasController methodsFor: 'control defaults'!
isControlActive
^super isControlActive & (sensor blueButtonPressed not) &
tool isControlActive! !
!CanvasController methodsFor: 'tool access'!
tool
^tool!
tool: aTool
tool _ aTool.
tool initializeWithModel: self model
view: self view
controller: self.! !
!CanvasController methodsFor: 'basic control sequence'!
controlInitialize
"Save old cursor, install new one"
lastYellowButtonMessage = #createIcon "redraw display to show new icon"
ifTrue:
[lastYellowButtonMessage _ nil.
view display].
saveCursor _ Cursor currentCursor.
model cursor show.
tool controlInitialize!
controlTerminate
"Restore old cursor"
saveCursor show.
tool controlTerminate.! !
!CanvasController methodsFor: 'accessing'!
redButtonResult
"return the result of the last RedButtonActivity"
^redButtonResult! !
!CanvasController methodsFor: 'menu messages'!
menuMessageReceiver
"Answer the object that should be sent a message when a menu item is selected."
^self tool!
redButtonActivity
"Keep result of redButtonActivity for later use.."
redButtonResult _ self tool redButtonActivity!
yellowButtonActivity
"Determine which item in the yellow button pop-up menu
is selected.
If one is selected, then send the corresponding message
to the object
designated as the menu message receiver."
| index |
yellowButtonMenu ~~ nil
ifTrue:
[index _ yellowButtonMenu startUpYellowButton.
index ~= 0
ifTrue:
[lastYellowButtonMessage _ yellowButtonMessages at: index.
self menuMessageReceiver perform: lastYellowButtonMessage]]
ifFalse: [super controlActivity]! !
ScrollController subclass: #PaletteController
instanceVariableNames: 'tools currentTool '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
PaletteController comment:
'I am used to display a palette on the side of my View''s window. I inform
my View when a new icon has been selected in the palette.
Instance variables:
tools <OrderedCollection>
a collection of the icons to display in the palette.
currentTool <Form>
the currently selected icon'!
!PaletteController methodsFor: 'initialize-release'!
initialize
super initialize.
scrollBar _ Quadrangle new
borderWidthLeft: 2 right: 1 top: 2 bottom: 2! !
!PaletteController methodsFor: 'basic control sequence'!
controlInitialize
| displayBox |
displayBox _ view insetDisplayBox expandBy: 0@2.
scrollBar _ scrollBar align: scrollBar topRight with: displayBox topLeft.
savedArea _ Form fromDisplay: scrollBar.
scrollBar display.
self displayTools!
controlTerminate
super controlTerminate.
Cursor normal show! !
!PaletteController methodsFor: 'control defaults'!
isControlActive
^super isControlActive & sensor blueButtonPressed not!
scrollActivity
sensor anyButtonPressed
ifTrue: [self selectTool]!
scrollLoop
Cursor normal show.
[self scrollBarContainsCursor]
whileTrue:
[Processor yield.
self scrollActivity]! !
!PaletteController methodsFor: 'model access'!
model: aModel
super model: aModel.
self tools: self view tools! !
!PaletteController methodsFor: 'tool accessing'!
currentTool
^currentTool!
currentTool: aTool
currentTool _ aTool.
view installTool: (tools indexOf: aTool) "install controllers in canvas(es)"!
displayTools
marker displayAt: scrollBar inside topLeft.
self highlightTool: currentTool!
highlightTool: aTool
| anInteger origin |
aTool isNil ifTrue: [^self].
anInteger _ (tools indexOf: aTool).
origin _ (self paletteTransformation applyTo: 0@anInteger) + 3.
Display reverse: (origin extent: -3+currentTool extent)!
selectTool
| aTool |
aTool _ self toolLoop.
aTool isNil
ifTrue: [self highlightTool: currentTool]
ifFalse: [self currentTool: aTool]!
tools: aCollection
tools _ aCollection.
self currentTool: aCollection first.
self updateMarker!
updateMarker
| aTool border |
aTool _ tools anElement.
marker _ Form extent: (aTool width + self toolBorder) @ (self toolHeight * tools size - self toolSeparation).
marker offset: self markerInset.
border _ 0@0 extent: aTool extent + self toolBorder.
tools do:
[:each |
each displayOn: marker at: border topLeft + self toolInset.
marker border: border width: 1.
border _ border translateBy: 0 @ (border height + self toolSeparation)].
scrollBar region: (marker boundingBox expandBy: self markerInset * 2)! !
!PaletteController methodsFor: 'scrolling'!
scroll
"Check to see whether the user wishes to jump, scroll up, or scroll down."
self scrollLoop! !
!PaletteController methodsFor: 'private'!
markerInset
^2@2!
paletteTransformation
^WindowingTransformation
window: (0@1 extent: 1@tools size)
viewport: (scrollBar inside topLeft + 1 extent: currentTool width @ (self toolHeight * tools size))!
selectedTool
| index |
index _ self toolIndexFor: sensor cursorPoint.
^(index between: 1 and: tools size)
ifTrue: [tools at: index]
ifFalse: [nil]!
toolBorder
^1!
toolHeight
^currentTool height + self toolSeparation + self toolBorder!
toolIndexFor: aPoint
| newPoint |
newPoint _ self paletteTransformation applyInverseTo: sensor cursorPoint.
(newPoint x between: 0 and: 1)
ifTrue: [^newPoint y truncated]
ifFalse: [^0]!
toolInset
^0@0!
toolLoop
| aTool |
self highlightTool: currentTool.
self highlightTool: (self selectedTool).
sensor
follow:
[:aPoint | aTool _ self selectedTool]
doing:
[:old :new | self highlightTool: old.
self highlightTool: new.
aTool _ self selectedTool].
^aTool!
toolSeparation
^2! !
Controller subclass: #NoPaletteController
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
NoPaletteController comment:
'I can be used if there is no palette in the application, that is, the operations
are handled via menus. There must be one tool in the system, and that
tool is installed at startup.
'!
!NoPaletteController methodsFor: 'model access'!
model: aModel
"Install the first tool as the initial tool."
super model: aModel.
view installTool: 1! !
DisplayObject subclass: #Foible
instanceVariableNames: 'forms boundingBoxCache '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
Foible comment:
'I am the abstract class of all components of a visual program (links and
boxes).
Instance Variables:
forms <OrderedCollection>
collection of forms used for my visual representation.
boundingBoxCache <Rectangle>
stores my boundingBox, so it doesn''t have to be calculated each
time.
'!
!Foible methodsFor: 'comparing'!
containsPoint: aPoint
"Return whether this point is in one of our forms"
| aRect |
self forms do:
[:each |
aRect _ (Rectangle origin: each offset extent: each extent) translateBy: self offset.
(aRect containsPoint: aPoint)
ifTrue: [^OrderedCollection with: self]].
^OrderedCollection new! !
!Foible methodsFor: 'private'!
createForms
"This is the method that creates the form. Subclasses implement this"
self subclassResponsibility.
"This should be done in any implementation..."!
removeAllForms
forms _ OrderedCollection new.
boundingBoxCache _ nil. "Invalidates the boundingBox, of course"! !
!Foible methodsFor: 'printing'!
prepareToStore
"Get the box ready to store- clear the form (waste)"
self removeAllForms! !
!Foible methodsFor: 'form access'!
baseForm
^self class baseForm!
forms
(forms isEmpty) ifTrue: [self createForms].
^forms! !
!Foible methodsFor: 'accessing'!
boundingBox
"return boundingBox, compute if not already computed"
boundingBoxCache notNil ifTrue: [^boundingBoxCache].
^boundingBoxCache _ self computeBoundingBox!
computeBoundingBox
"Compute the smallest rectangle which will hold all the
Forms in this Foible (with offset)"
| aRectangle |
aRectangle _ self forms first relativeRectangle.
self forms do:
[:each | aRectangle _ aRectangle merge: each relativeRectangle].
^aRectangle translateBy: self offset!
connectedTo: aFoibleBox
"Check to see if self is connected to some other FoibleBox"
^self subclassResponsibility!
hasPorts
^false!
name
^self subclassResponsibility!
name: aValue
^self subclassResponsibility!
value
"This should be a good message for all subclasses..."
self subclassResponsibility! !
!Foible methodsFor: 'initialize'!
initialize
forms _ OrderedCollection new.! !
!Foible methodsFor: 'interface tests'!
acceptsDataLinks: aPoint
^self subclassResponsibility!
canBeCopied
^true!
canBeDeleted
^true!
canMoveDependently
"Return whether I can be moved when I am in a Control box being moved"
^true!
canMoveIndependently
"Return whether I can move at the user's request"
^true!
givesDataLinks: aPoint
^self subclassResponsibility! !
!Foible methodsFor: 'displaying-generic'!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
"Simply blit the forms on aDisplayMedium, within clipRectangle "
self forms do: [:form | form
displayOn: aDisplayMedium
at: aDisplayPoint + self offset
clippingBox: clipRectangle
rule: ruleInteger
mask: aForm]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Foible class
instanceVariableNames: 'myForm '!
!Foible class methodsFor: 'instance creation'!
new
"Create a new box"
^super new initialize! !
!Foible class methodsFor: 'form access'!
baseForm
"Return the form for this class"
myForm isNil ifTrue: [myForm _ self getIcon].
^myForm deepCopy!
getIcon
"ask IconManager to get the form for my icon"
^ self getIcon: self name!
getIcon: iconName
"ask IconManager to get the icon with name aName"
^ IconManager getIcon: iconName fromDirectory: self iconDirectory! !
!Foible class methodsFor: 'class initialization'!
initializeForms
" send this class method when the form for my class has been changed "
" <class name> initializeForms "
myForm _ self getIcon! !
Foible subclass: #FoibleBox
instanceVariableNames: 'name location owner '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
FoibleBox comment:
'I am the abstract class of all boxes in a visual program.
Instance Variables:
name <String>
uniquely identifies me in visual program.
location <Point>
my location on the screen (in View coordinates). this is really my
offset. one use of location is to display my icon, since it does not
know its location on the screen (its offset should be 0@0, or
problems will arise).
owner <FoibleManager>
this is the manager that is in charge of me. it tells me when to
display myself, and also tells me when to move or delete myself, or
my links.'!
!FoibleBox methodsFor: 'accessing'!
box
" this method is needed when a Box does not have Ports (BoxWithDirectLinks),
because FoibleLink send messages to source (and destination) box, and the
source and destination of a link to a BoxWithDiectLinks is the box "
^self!
connectedTo: aFoibleBox
"a FoibleBox is not directly connected to any other foibleBox"
^false!
extent
^self forms first extent!
inside: aManager
" determine if I am inside aManager -
i.e. I am managed by aManager or my manager is inside aManager "
owner==aManager ifTrue: [^true].
(owner topLevel) ifTrue: [^false].
^owner inside: aManager!
linkedTo: aFoibleBox
self links do: [:each | (each linkedTo: aFoibleBox)
ifTrue: [^true]].
^false!
links
^self subclassResponsibility!
name
^name!
name: aValue
name _ aValue.!
offset
^location!
offset: aValue
aValue x < 0 ifTrue: [^self error:'bad offset given'].
aValue y < 0 ifTrue: [^self error:'bad offset given'].
location _ aValue.
boundingBoxCache _ nil!
owner
"the manager that is responsable for me"
^owner!
setManager: aManager
owner_aManager! !
!FoibleBox methodsFor: 'adding'!
addLink: aBoxLink
^self subclassResponsibility! !
!FoibleBox methodsFor: 'initialization'!
initializeAt: aPoint withName: aName
^self subclassResponsibility! !
!FoibleBox methodsFor: 'removing'!
remove
" tell my manager to remove me from his list, and remove my links,
and if I am a complexBox (my manager is not nil), then tell my manager
to delete all Foibles that he owns "
| aRect tmpRect |
aRect _ self owner removeBox: self.
aRect _ aRect merge: self removeLinks.
self manager notNil
ifTrue: [tmpRect _ self manager removeAll.
tmpRect notNil
ifTrue: [aRect _ aRect merge: tmpRect]].
^aRect!
removeLink: aLink
^self subclassResponsibility!
removeLinks
" tell all of my links to remove themselves "
| aRect |
aRect _ self boundingBox.
self links do: [:each | aRect _ aRect merge: each remove].
^aRect! !
!FoibleBox methodsFor: 'form access'!
ghostForm
"Return a ghosted copy of the Form representing
aFoibleBox without the offset. The cursor should always
start at 0@0, so we get a Form that does."
| aForm |
aForm _ self baseForm offset: 0 @ 0.
^aForm reverse: (Rectangle origin: 0 @ 0 extent: aForm extent)
mask: Form veryLightGray! !
!FoibleBox methodsFor: 'finding'!
findAllIntersecting: aRect
"Return an OrderedCollection of all the FoibleBoxes that
intersect the area described by aRect. If aRect intersects
this FoibleBox, return an OrderedCollection containing
this box. If not, return an empty OrderedCollection.
aRect is the area of some FoibleBox."
((self boundingBox intersects: aRect)
and: [self boundingBox ~= aRect])
ifTrue: ["Don't return an OC containing this FoibleBox, if this
FoibleBox's boundingBox boundingBox exactly
equals aRect. Every FoibleBox intersects itself, but
we aren't interested in such FoibleBoxes."
^OrderedCollection with: self]
ifFalse: [^OrderedCollection new]! !
!FoibleBox methodsFor: 'moving'!
moveBy: aPoint topManager: topManager
" this moving method is called when I am inside of a complexBox. If I
have any links that originate outside of topManager, then tell the link to
change its image. If I am a complexBox, then tell my manager to translate
all of the Foibles that it manages by aPoint "
| aRect |
self offset: self offset+aPoint.
aRect _ self boundingBox.
self links do:
[:eachLink | (eachLink owner ~= self owner and: [ (eachLink isContainedIn: topManager) not])
ifTrue: [aRect _ aRect merge: (eachLink boxMoved: self by: aPoint)]].
self manager notNil
ifTrue: [aRect _ aRect merge: (self manager moveAllBy: aPoint topManager: topManager)].
^aRect!
moveFoiblesBy: aPoint
"tell all of myLinks that I moved by aPoint. Return a Rectangle composed of
the boundingBoxes of my links (in both their new and old positions) and my
boundingBox (so the return value is always nonNil). If I am a complexBox,
then tell my manager to move all of the Foibles that it manages by aPoint "
| aRect |
aRect _ self boundingBox.
self links do:
[:aLink | aRect _ aRect merge: (aLink boxMoved: self by: aPoint)].
self manager notNil
ifTrue: [aRect _ aRect merge: (self manager moveAllBy: aPoint)].
^aRect! !
!FoibleBox methodsFor: 'manager access'!
manager
"the receiver does not own a manager unless specifically set"
^nil! !
!FoibleBox methodsFor: 'port access'!
findInputPort: aPoint
"find and return an input port that can be linked to at aPoint"
^self subclassResponsibility!
findOutputPort: aPoint
"find and return an output port that can be linked to at aPoint "
^self subclassResponsibility! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleBox class
instanceVariableNames: ''!
!FoibleBox class methodsFor: 'instance creation'!
offset: aPoint withName: aString
"create aType FoibleBox at aPoint"
| foibleBox |
foibleBox _ super new.
foibleBox initializeAt: aPoint withName: aString.
^foibleBox! !
!FoibleBox class methodsFor: 'form access'!
iconDirectory
"return the directory that contains the icons for my icon"
self subclassResponsibility! !
FoibleBox subclass: #BoxWithDirectLinks
instanceVariableNames: 'links '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
BoxWithDirectLinks comment:
'I am the abstract class of boxes in a visual program that does not use Ports
to connect links and send information. Links are connected directly to
instances of me, and my instances talk directly to the links when
information is passed through the system.
Instance Variables:
links <OrderedCollection>
a collection of my links, used for both input and output. there is no
restriction placed on the number of links allowed, so if a restriction
is needed it must be implemented in a subclass of me.'!
!BoxWithDirectLinks methodsFor: 'accessing'!
links
" use a copy in case links are being deleted "
^links copy! !
!BoxWithDirectLinks methodsFor: 'adding'!
addLink: aBoxLink
links add: aBoxLink.! !
!BoxWithDirectLinks methodsFor: 'removing'!
removeLink: aBoxLink
links remove: aBoxLink.! !
!BoxWithDirectLinks methodsFor: 'initialization'!
initializeAt: aPoint withName: aName
name isNil ifFalse: [^self error:'Cannot reinitialize a ',self class name].
name _ aName.
self offset: aPoint.
links _ OrderedCollection new.! !
FoibleBox subclass: #BoxWithPorts
instanceVariableNames: 'inputPorts outputPort '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
BoxWithPorts comment:
'I am the abstract class of boxes in a visual program that use Ports to
connect links, and send information. Links are connected directly to my
ports, and when information is passed through the system, links talk to my
ports, and my ports talk to me.
Instance Variables:
inputPorts <OrderedCollection>
a collection of Ports, used for input, that links can connect to. only
one link can connect to each Port, so the number of inputs that I
have is limited to the number of Ports that I have in inputPorts.
outputPort <OrderedCollection>
a collection of one Port, used for output, that links can originate
from. there is no limit to the number of links that can originate from
this Port, that is why there there is only one outputPort.'!
!BoxWithPorts methodsFor: 'accessing'!
hasPorts
^true!
links
| myLinks |
myLinks _ OrderedCollection new.
inputPorts notNil
ifTrue: [ inputPorts do:
[:each | each link notNil
ifTrue: [myLinks add: each link]]].
outputPort notNil
ifTrue: [outputPort do:
[:each | each link notNil
ifTrue: [myLinks addAll: each link]]].
^myLinks! !
!BoxWithPorts methodsFor: 'adding'!
addLink: aBoxLink! !
!BoxWithPorts methodsFor: 'removing'!
removeLink: aBoxLink! !
!BoxWithPorts methodsFor: 'initialization'!
initializeAt: aPoint withName: aName
name isNil ifFalse: [^self error:'Cannot reinitialize a ',self class name].
name _ aName.
self offset: aPoint!
initializePorts
"initialize the ports of the BoxPorts"
"it has the form 'self inputs: 2'. FoibleBoxes have only 1 OutPutPort, but it can have many links."
self subclassResponsibility! !
!BoxWithPorts methodsFor: 'port access'!
initInputPortsFromRectangles: rectangles
inputPorts _ rectangles collect: [:each | (InputPort new: each)
box: self]!
initOutputPortsFromRectangles: rectangles
outputPort _ rectangles collect: [:each | (OutputPort new: each)
box: self]!
inputs: numInputs
"initializes a BoxWithPorts with the specified number of input
ports and one output port (which can hold many links)."
| rectangles newExtent newOrigin rectangle |
newExtent _ self extent x / 2 @ self extent y. "left half"
rectangles _ (Rectangle origin: 0 @ 0 extent: newExtent)
partition: numInputs.
self initInputPortsFromRectangles: rectangles.
newOrigin _ newExtent x @ 0.
rectangle _ Rectangle origin: newOrigin extent: newExtent. "right half"
outputPort _ (OutputPort new: rectangle) box: self!
inputs: numInputs outputs: numOutputs
| newExtent newOrigin rectangles |
inputPorts _ OrderedCollection new.
outputPort _ OrderedCollection new.
(numInputs = 0 and: [numOutputs = 0])
ifTrue: [^nil].
numInputs = 0
ifTrue:
[self outputs: numOutputs.
^nil].
numOutputs = 0
ifTrue:
[self inputs: numInputs.
^nil].
newExtent _ self extent x / 2 @ self extent y.
rectangles _ (Rectangle origin: 0 @ 0 extent: newExtent)
partition: numInputs.
self initInputPortsFromRectangles: rectangles.
newOrigin _ newExtent x @ 0.
rectangles _ (Rectangle origin: newOrigin extent: newExtent)
partition: numOutputs.
self initOutputPortsFromRectangles: rectangles!
outputs: numOutputs
"initializes a BoxWithPorts with the specified number of output
ports and zero input ports"
| rectangles |
rectangles _ (Rectangle origin: 0 @ 0 extent: self extent)
partition: numOutputs.
self initOutputPortsFromRectangles: rectangles! !
Foible subclass: #FoibleLink
instanceVariableNames: 'source destination '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
FoibleLink comment:
'I am the abstract class that represents links between boxes in a visual
program. I serve as a visual link between boxes, and I am used to pass
information through the system.
Instance Variables:
source <OutputPort> or <FoibleBox>
the object that I am directly connected to, on the box that I
originate from. source is an OutputPort when the box that I originate
from is a BoxWithPorts, and source is a FoibleBox when the box that
I originate from is a BoxWithDirectLinks.
destination <InputPort> or <FoibleBox>
the object that I am directly connected to, on the box that I connect
to. destination is an InputPort when the box that I connect to is a
BoxWithPorts, and destination is a FoibleBox when the box that I
connect to is a BoxWithDirectLinks.'!
!FoibleLink methodsFor: 'initialization'!
from: aSource to: aDest withPath: newPath
"Initialize this FoibleLink linked from aSource to
aDest, using the given newPath to make my form"
source isNil ifFalse: [self error: 'cannot re-initialize a ' , self class name].
(aDest box linkedTo: aSource box)
ifTrue:
[PopUpNotifier message: 'Circular link: ' , aSource name , ' is already connected to ' , aDest name.
^nil].
source _ aSource.
source addLink: self.
destination _ aDest.
destination addLink: self.
self path: newPath! !
!FoibleLink methodsFor: 'moving'!
boxMoved: aFoibleBox by: aPoint
" I need to change my form when one of my boxes moves "
(self connectedTo: aFoibleBox)
ifTrue: [^self remakeForm: aFoibleBox by:aPoint].!
boxMoved: aFoibleBox moveAllBy: aPoint
(self connectedTo: aFoibleBox)
ifTrue: [self moveBy: aPoint].!
moveBy: aPoint
" translate all of my forms by aPoint "
| aRect |
aRect _ self boundingBox.
forms do:
[:line | line beginPoint: line beginPoint+aPoint.
line endPoint: line endPoint+aPoint].
boundingBoxCache _ nil.
^ aRect merge: self boundingBox! !
!FoibleLink methodsFor: 'removing'!
remove
"tell my manager to remove me from his list, and tell my ports to remove me"
destination removeLink: self.
source removeLink: self.
^self owner removeLink: self! !
!FoibleLink methodsFor: 'accessing'!
box
^source box!
boxName
^source box name!
connectedTo: aFoibleBox
^destination box = aFoibleBox | (source box = aFoibleBox)!
defaultLineClass
"answer the type of line to use"
^FoibleLine!
formAtPoint: aPoint
"return the topmost form of mine, if any that contain aPoint"
| theIndex |
theIndex_(self forms findFirst: [:each | each relativeRectangle containsPoint: aPoint]).
theIndex=0 ifTrue:[^nil].
^self forms at: theIndex!
isContainedIn: aMgr
"return true if I am managed by aMgr (FoibleManager)"
^(source box inside: aMgr) and: [destination box inside: aMgr]!
isFirstInPath: aLine
^aLine=self forms first!
isLastInPath: aLine
^aLine=self forms last!
lineAfter: aLine
"Return the line that is after aLine in path"
(self forms includes: aLine)
ifTrue:[(self isLastInPath: aLine)
ifFalse:[^self forms after: aLine]].
^nil!
lineBefore: aLine
"Return the line that is before aLine in path"
(self forms includes: aLine)
ifTrue:[(self isFirstInPath: aLine)
ifFalse:[^self forms before: aLine]].
^nil!
linkedTo: aFoibleBox
^destination box = aFoibleBox!
name
^(self class name,' from ',source name,' to ',destination name)!
offset
^0@0!
owner
^source box owner!
path: aPath
"Change the path of this link to aPath"
self makeForm: aPath.!
source
^source!
toBox
^destination box!
value
^source value! !
!FoibleLink methodsFor: 'private'!
addLinesFor: aBox movedBy: aPoint
"replace single line in path between boxes with three lines
note: this should be called only if I have 1 line in the path "
| newPath theLine oldBegin oldEnd newBegin newEnd loc2 loc3 aRect |
newPath _ OrderedCollection new.
theLine _ self forms last.
aRect _ theLine relativeRectangle.
oldBegin _ theLine beginPoint.
oldEnd _ theLine endPoint.
(self source box = aBox) "for firstLine horizontal"
ifTrue:[newBegin_oldBegin+aPoint.
newEnd_oldEnd]
ifFalse:[newEnd_oldEnd+aPoint.
newBegin_oldBegin].
theLine horizontal
ifTrue:[loc2_(newBegin x + newEnd x) abs // 2 @ newBegin y.
loc3_(newBegin x + newEnd x) abs // 2 @ newEnd y.]
ifFalse:[loc2_ newBegin x @ ((newBegin y + newEnd y) abs // 2).
loc3_newEnd x @ ((newBegin y + newEnd y) abs // 2).].
newPath add: (self defaultLineClass from: newBegin to: loc2);
add: (self defaultLineClass from: loc2 to: loc3);
add: (self defaultLineClass from: loc3 to: newEnd).
self replacePathFromLine: theLine toLine: theLine withLines: newPath.
newPath do: [:each | aRect _ aRect merge: each relativeRectangle].
^ aRect!
addPattern: anInfiniteForm toForm: aForm
"Give this form the pattern from anInfiniteForm"
anInfiniteForm
displayOn: aForm
at: aForm offset
clippingBox: aForm boundingBox
rule: Form over
mask: nil!
createForms
"if this method is called, then something's wrong, because my form
should never be empty; it is created immediately"
self error: 'forms is empty, and should not be'!
makeForm: newPath
" Create the forms necessary to represent this linkbox along path"
self removeAllForms.
newPath do: [:line | forms add: line.
line link: self.
line displayForm]!
remakeForm: aBox by: aPoint
" fix my forms after aBox has moved "
| aRect |
(self forms size) = 1
ifTrue:[aRect _ self addLinesFor: aBox movedBy: aPoint]
ifFalse:[aRect _ self stretchLinesFor: aBox movedBy: aPoint].
boundingBoxCache _ nil.
^aRect!
replacePathFromLine: from toLine: to withLines: newLines
| newPath |
from=forms first
ifTrue:[newPath_OrderedCollection new.]
ifFalse:[newPath_forms copyFrom: (forms indexOf: (forms first)) to: (forms indexOf: (forms before: from)).].
newPath addAll: newLines.
to=forms last
ifFalse:[newPath addAll: (forms copyFrom: (forms indexOf: (forms after: to)) to: (forms indexOf: (forms last))).].
^self path: newPath!
stretchLinesFor: aBox movedBy: aPoint
"adjust first 2 (or last 2) lines in path due to aBox moving"
| line1 line2 loc1 loc2 loc3 newLines aRect |
newLines_OrderedCollection new.
(self source box = aBox) "link is coming out of box"
ifTrue:[line1_self forms first.
line2_line1 next.
loc1_line1 beginPoint+aPoint.
loc3_line2 endPoint]
ifFalse:[line2_self forms last. "link is going into box"
line1_line2 prev.
loc3_line2 endPoint+aPoint.
loc1_line1 beginPoint].
line1 horizontal
ifTrue:[loc2_loc3 x@loc1 y]
ifFalse:[loc2_loc1 x@loc3 y].
" lines may change direction, so just replace them "
newLines add: (self defaultLineClass from: loc1 to: loc2);
add: (self defaultLineClass from: loc2 to: loc3).
self replacePathFromLine: line1 toLine: line2 withLines: newLines.
aRect _ line1 relativeRectangle merge: line2 relativeRectangle.
newLines do: [:each | aRect _ aRect merge: each relativeRectangle].
^ aRect! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleLink class
instanceVariableNames: 'east linkWidth north south west '!
!FoibleLink class methodsFor: 'instance creation'!
from: aSource to: aDest withPath: path
"Create a new Link linked from fromPort to toPort,
following path points to draw the link"
| newLink |
newLink _ super new.
^newLink from: aSource to: aDest withPath: path! !
!FoibleLink class methodsFor: 'class initialization'!
initializeForms
myForm _ self getIcon.
linkWidth _ myForm extent x. "Width of link forms"
north _ InfiniteForm with: myForm.
east _ InfiniteForm with: (myForm rotateBy: 1).
south _ InfiniteForm with: (myForm rotateBy: 2).
west _ InfiniteForm with: (myForm rotateBy: 3)! !
!FoibleLink class methodsFor: 'form access'!
eastForm
"Return the eastward infinite form for this class"
east isNil ifTrue: [self initializeForms].
^east deepCopy!
iconDirectory
"return the directory that contains the icons for the FlowKit"
^FoibleDirectory iconDirectory!
northForm
"Return the northward infinite form for this class"
north isNil ifTrue: [self initializeForms].
^north deepCopy!
southForm
"Return the southward infinite form for this class"
south isNil ifTrue: [self initializeForms].
^south deepCopy!
westForm
"Return the westward infinite form for this class"
west isNil ifTrue: [self initializeForms].
^west deepCopy!
width
"Return the width of this type of link"
linkWidth isNil ifTrue: [self initializeForms].
^linkWidth! !
DisplayObject subclass: #FoibleManager
instanceVariableNames: 'boxes links ourCursor nameNum myBox program '
classVariableNames: 'MinRect '
poolDictionaries: ''
category: 'Foible'!
FoibleManager comment:
'I manage a collection of Foibles. Visually, I manage the 2 1/2 dimensional
representation of my Foibles, and the links between my Foibles. I also can
be asked for any or all of my Foibles that meet a certain criterea.
Instance Variables:
boxes <OrderedCollection>
a collection of the FoibleBoxes that I manage.
links <OrderedCollection>
a collection of the FoibleLinks that I manage.
ourCursor <Cursor>
stores the cursor for the currently active Tool. it is initialized to a
normal cursor. only top-level managers seem to need this variable.
nameNum <Integer>
used to uniquely name each new box that is created.
myBox <FoibleBox> or nil
nonNil only when I am the manager of a ComplexBox. if myBox is
nonNil, then I am managing the Foibles inside of myBox, otherwise I
am managing the Foibles in a canvas (I am a top-level manager).
program <FoibleProgram> or nil
nonNil only when I am a top-level manager. program is the
top-level model of an executing application
NOTE: if multiple-inheritance get working, then there probably should be
two subclasses of FoibleManager, with the instance variables distributed
like this:
Foible (boxes, links, nameNum)
TopLevelManager (ourCursor, program)
ComplexBoxManager (myBox)'!
!FoibleManager methodsFor: 'accessing'!
cursor
^ourCursor!
cursor: aCursor
ourCursor _ aCursor.!
inside: aManager
^myBox inside: aManager!
isEmpty
^((boxes size) = 0)!
isManagerOf: aFoible
"test to see if aFoible is under management of the receiver "
^self = aFoible owner!
myBox
^myBox!
nameNum
^nameNum!
nameNum: aNumber
"Set the nameNum, complain if not nil"
nameNum isNil
ifTrue: [nameNum _ aNumber]
ifFalse: [self error: 'Cannot change nameNum'].!
owner
^myBox owner!
program
^program!
program: aProgram
program _ aProgram!
topLevel
" returns true if I am a top level manager (the manager of a canvas) "
^program notNil! !
!FoibleManager methodsFor: 'moving'!
moveAllBy: aPoint
" translate of my foibles"
^self moveAllBy: aPoint topManager: self!
moveAllBy: aPoint topManager: topManager
" translate of my foibles, the highest level box moved is managed by topManager"
| movableBoxes aRect |
aRect _ myBox boundingBox.
movableBoxes _ boxes select: [:each | each canMoveDependently].
movableBoxes do:
[:each | aRect _ aRect merge: (self moveBox: each By: aPoint topManager: topManager)].
links do:
[:each |
(each isContainedIn: topManager)
ifTrue: [ "this link is totally inside me, so just translate it"
aRect _ aRect merge: (each moveBy: aPoint)]
ifFalse: [ "this link originates in me, but ends up outside of me"
aRect _ aRect merge: (each boxMoved: each box by: aPoint)]].
^aRect!
moveBox: aBox By: aPoint topManager: topManager
" translate aBox, the highest level box moved is managed by topManager "
| aRect |
aRect _ self removeBox: aBox.
aRect _ aRect merge: (aBox moveBy: aPoint topManager: topManager).
boxes addLast: aBox.
^aRect!
moveBox: aBox byBlock: aBlock
"Move aBox according to aBlock, relocating aBox to the back of the list, to
retain 2 1/2 D. If I do not currently manage aBox, then remove aBox (and
all of its links) from it current manager, and add aBox to my list of boxes"
| bigBox oldOffset |
(self isManagerOf: aBox)
ifTrue: [bigBox _ self removeBox: aBox]
ifFalse: [bigBox _ aBox owner removeBox: aBox.
bigBox _ bigBox merge: aBox removeLinks].
oldOffset _ aBox offset.
aBlock value: aBox.
bigBox _ bigBox merge: (aBox moveFoiblesBy: ((aBox offset) - oldOffset)).
aBox setManager: self.
boxes addLast: aBox.
^bigBox merge: aBox boundingBox! !
!FoibleManager methodsFor: 'adding'!
addBox: boxBlock
"add a new FoibleBox created with boxBlock with the latest name"
| foibleBox name stream |
name _ 'Box','#############'.
stream _ WriteStream on: name from: 4 to: (name size).
nameNum printOn: stream.
name _ name copyUpTo: $#.
nameNum _ nameNum + 1.
foibleBox _ boxBlock value: name.
foibleBox hasPorts
ifTrue: [foibleBox initializePorts].
boxes add: foibleBox.
^foibleBox boundingBox!
addLink: newLink
links add: newLink.
^newLink boundingBox!
addLink: aLinkClass from: fromPort to: toPort withPath: path
| aLink |
aLink _ aLinkClass
from: fromPort
to: toPort
withPath: path.
aLink isNil ifTrue: [^nil].
^self addLink: aLink! !
!FoibleManager methodsFor: 'removing'!
remove: aFoible
"tell aFoible to remove itself"
^ aFoible remove!
removeAll
"tell all of my boxes to remove themselves"
| myBoxes aRect tmpRect |
myBoxes _ boxes shallowCopy.
myBoxes do:
[:each | tmpRect _ each remove.
aRect isNil
ifTrue: [aRect _ tmpRect]
ifFalse: [aRect _ aRect merge: tmpRect]].
^aRect!
removeBox: aFoibleBox
boxes remove: aFoibleBox.
^ aFoibleBox boundingBox!
removeLink: aFoibleLink
links remove: aFoibleLink.
^ aFoibleLink boundingBox! !
!FoibleManager methodsFor: 'initialize'!
initialize
"initialize this new top-level manager"
boxes _ OrderedCollection new.
links _ OrderedCollection new.
ourCursor _ Cursor normal.
nameNum _ 1!
initializeWithBox: aBox
"initialize this new complexBox manager with aBox as my matching box"
boxes _ OrderedCollection new.
links _ OrderedCollection new.
ourCursor _ Cursor normal.
nameNum _ 1.
myBox _ aBox! !
!FoibleManager methodsFor: 'printing'!
prepareToStore
"get the box ready to store - get rid of
recreateable viewForm, and tell boxes to kill their forms"
"First, calculate next value based on present value"
boxes do: [ :each | each prepareToStore].
links do: [ :each | each prepareToStore].! !
!FoibleManager methodsFor: 'comparing'!
containsPoint: aPoint
"Return an Ordered Collection of the boxes that contain aPoint"
| anOrderedCollection |
anOrderedCollection _ OrderedCollection new.
links do: [:each | anOrderedCollection addAll: (each containsPoint: aPoint)].
boxes do: [:each | anOrderedCollection addAll: (each containsPoint: aPoint)].
" myBox notNil
ifTrue: [(myBox containsPoint: aPoint)
ifTrue: [anOrderedCollection add: myBox]]."
^anOrderedCollection! !
!FoibleManager methodsFor: 'displaying-generic'!
computeBoundingBox
"Compute the smallest rectangle which will hold all the Foibles in the
receiver, or the minimum rectangle (as defined in the class variable
MinRect), whichever is larger"
| aRectangle |
boxes size < 1 ifTrue: [^MinRect "Rectangle origin: 0@0 corner: 0@0"].
aRectangle _ boxes first boundingBox.
boxes do:
[:each | aRectangle _ aRectangle merge: each boundingBox].
links do:
[:each | aRectangle _ aRectangle merge: each boundingBox].
^aRectangle!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
"display all foibles intersecting clipRectangle on aDisplayMedium"
boxes do: [:each | (each boundingBox intersects: (clipRectangle translateBy: aDisplayPoint negated))
ifTrue: [each
displayOn: aDisplayMedium
at: aDisplayPoint
clippingBox: clipRectangle
rule: ruleInteger
mask: aForm].
each manager notNil
ifTrue: [each manager
displayOn: aDisplayMedium
at: aDisplayPoint
clippingBox: clipRectangle
rule: ruleInteger
mask: aForm]].
links do: [:each | (each boundingBox intersects: (clipRectangle translateBy: aDisplayPoint negated))
ifTrue: [each
displayOn: aDisplayMedium
at: aDisplayPoint
clippingBox: clipRectangle
rule: ruleInteger
mask: aForm]].! !
!FoibleManager methodsFor: 'finding'!
find: aPoint
"return the Foible that the cursor is on, if any"
| aRect found |
links
reverseDo: "Reverse for 2 1/2 D action"
[:each |
found _ each containsPoint: aPoint.
found isEmpty not ifTrue: [^found first]].
boxes
reverseDo: "Reverse for 2 1/2 D action"
[:each |
found _ each containsPoint: aPoint.
found isEmpty not ifTrue: [^found first]].
^nil!
find: aPoint suchThat: aBlock
"return the Foible that the cursor is on, if any,
that evaluates aBlock as true"
| anOrderedCollection |
anOrderedCollection _ self containsPoint: aPoint.
anOrderedCollection reverseDo: [:each | (aBlock value: each)
ifTrue: [^each]].
^nil!
find: aPoint suchThatTwo: aBlock
"return the Foible that the cursor is on, if any,
that evaluates aBlock as true"
| anOrderedCollection |
anOrderedCollection _ self containsPoint: aPoint.
anOrderedCollection reverseDo: [:each | (aBlock value: each value: aPoint)
ifTrue: [^each]].
^nil!
findAllIntersecting: aRect
"Return an OrderedCollection of all the FoibleBoxes that
intersect the area described by aRect. This
OrderedCollection may be empty, have one element, or
have more than one element. It will never contain any
FoibleLinks. aRect is the area of some FoibleBox."
| result |
result _ OrderedCollection new.
boxes do: [:aFoible |
(aFoible isKindOf: FoibleBox)
ifTrue: [result addAll: (aFoible findAllIntersecting: aRect)]].
^result!
findAllLinksSuchThat: aBlock
"Return an OrderedCollection of all the links (there may be more than one) that evaluate aBlock as true."
| result |
result _ OrderedCollection new.
links
reverseDo: "Reverse for 2 1/2 D action"
[:each | (aBlock value: each)
ifTrue: [result add: each]].
^result!
findAllSuchThat: aBlock
"Return an OrderedCollection of all the Foibles (there may be more than one) that evaluate aBlock as true."
| result |
result _ OrderedCollection new.
links
reverseDo: "Reverse for 2 1/2 D action"
[:each | (aBlock value: each)
ifTrue: [result add: each]].
boxes reverseDo: "Reverse for 2 1/2 D action"
[:each | (aBlock value: each)
ifTrue: [result add: each]].
^result!
findName: aString
"Return Foible with name aString"
^self findSuchThat: [:each | (each name sameAs: aString)]!
findSuchThat: aBlock
"return the Foible that evaluates aBlock as true"
links
reverseDo: "Reverse for 2 1/2 D action"
[:each | (aBlock value: each)
ifTrue: [^each]].
boxes
reverseDo: "Reverse for 2 1/2 D action"
[:each | (aBlock value: each)
ifTrue: [^each]].
^nil! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleManager class
instanceVariableNames: ''!
!FoibleManager class methodsFor: 'instance creation'!
new
"create a new instance with cursor and type initialized"
| aFoibleManager |
aFoibleManager _ super new.
aFoibleManager initialize.
^aFoibleManager!
newWithBox: aBox
"create a new instance with cursor and type initialized and aBox
as my matching box - added by Bill 10/25"
| aFoibleManager |
aFoibleManager _ super new.
aFoibleManager initializeWithBox: aBox.
^aFoibleManager! !
!FoibleManager class methodsFor: 'class initialization'!
initialize
"FoibleManager initialize"
MinRect _ Rectangle origin: (0@0) extent: (150@150).! !
FoibleManager initialize!
Line subclass: #FoibleLine
instanceVariableNames: 'link '
classVariableNames: 'DrawingForm '
poolDictionaries: ''
category: 'Foible'!
FoibleLine comment:
'I am the form that a FoibleLink''s form consists of. I can display myself as a
line, which is used when my link is being created or edited, and I can
display myself as a form, which is used when my FoibeLink wants to
display its form.
I am an abstract class, but requests for new FoibleLines are sent to my
class method from: to:. There are 4 concrete subclasses of me: NorthLine,
SouthLine, EastLine, and WestLine, and in my class creation method I
determine which of my subclasses to create.
Instance Variables:
link <FoibleLink>
the FoibleLink whose form I am a part of.
Class Variable:
drawingForm <Form>
the Form used to create my line representation.'!
!FoibleLine methodsFor: 'form access'!
formFor: aLink
"return the form representing the receiver's image"
self subclassResponsibility! !
!FoibleLine methodsFor: 'initialize'!
from: sourcePoint to: destPoint withForm: aForm
self beginPoint: sourcePoint.
self endPoint: destPoint.
self form: aForm! !
!FoibleLine methodsFor: 'displaying'!
displayForm
^self formFor: self link!
displayLineOn: aDisplayMedium clippingBox: clipRect rule: anInteger mask: aForm
" display myself as a Line "
collectionOfPoints size < 2 ifTrue: [self error: 'a line must have two points'].
aDisplayMedium
drawLine: self form
from: self beginPoint + clipRect origin
to: self endPoint + clipRect origin
clippingBox: clipRect
rule: anInteger
mask: aForm!
displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
" display myself as a Link"
aDisplayMedium copyBits: self boundingBox
from: (self formFor: self link)
at: aDisplayPoint + self offset
clippingBox: clipRectangle
rule: ruleInteger
mask: aForm!
eraseFormInClipBox: aClipBox
self displayOn: Display
at: aClipBox origin
clippingBox: (self relativeRectangle moveBy: aClipBox origin)
rule: Form erase "reverse"
mask: nil. "display opposite of whats on screen"!
formToLineInClippingBox: aClippingBox
"turn form white, and draw the line on the screen"
self eraseFormInClipBox: aClippingBox.
self xorInClippingBox: aClippingBox!
xorInClippingBox: aClippingBox
self displayLineOn: Display
clippingBox: aClippingBox
rule: Form reverse
mask: nil. "display opposite of whats on screen"! !
!FoibleLine methodsFor: 'accessing'!
extent
^(self formFor: self link) extent!
horizontal
self subclassResponsibility!
link
^link!
link: aLink
link_aLink!
next
^self link lineAfter: self!
offset
^(self formFor: self link) offset!
prev
^self link lineBefore: self!
relativeRectangle
^(self formFor: self link) relativeRectangle!
vertical
self subclassResponsibility! !
!FoibleLine methodsFor: 'display box access'!
computeBoundingBox
^(self formFor: self link) computeBoundingBox! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleLine class
instanceVariableNames: ''!
!FoibleLine class methodsFor: 'instance creation'!
from: source to: dest
"create a new FoibleLine, decide whether it points North,
South, East, or West, using DrawForm"
source x = dest x
ifTrue: [source y < dest y
ifTrue: [^SouthLine
from: source
to: dest
withForm: DrawingForm]
ifFalse: [^NorthLine
from: source
to: dest
withForm: DrawingForm]]
ifFalse:
[source y = dest y ifFalse: [self error: 'must be right angles'].
source x < dest x
ifTrue: [^EastLine
from: source
to: dest
withForm: DrawingForm]
ifFalse: [^WestLine
from: source
to: dest
withForm: DrawingForm]]!
from: source to: dest withForm: aForm
"create a new FoibleLine, decide whether it points North,
South, East, or West"
source x = dest x
ifTrue: [source y < dest y
ifTrue: [^SouthLine
from: source
to: dest
withForm: aForm]
ifFalse: [^NorthLine
from: source
to: dest
withForm: aForm]]
ifFalse:
[source y = dest y ifFalse: [self error: 'must be right angles'].
source x < dest x
ifTrue: [^EastLine
from: source
to: dest
withForm: aForm]
ifFalse: [^WestLine
from: source
to: dest
withForm: aForm]]! !
!FoibleLine class methodsFor: 'class initialization'!
initialize
"FoibleLine initialize"
DrawingForm _ Form extent: 1@1.
DrawingForm black.! !
FoibleLine initialize!
FoibleLine subclass: #EastLine
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
!EastLine methodsFor: 'form access'!
formFor: aLink
"return the form representing the receiver's image"
| aForm compensate |
compensate _ aLink class width // 2.
aForm _ Form extent: (self endPoint x - self beginPoint x) asInteger @ aLink class width.
aLink class eastForm
displayOn: aForm
at: aForm offset
clippingBox: aForm boundingBox
rule: Form over
mask: nil.
aForm offset: self beginPoint x @ (self beginPoint y - compensate).
^aForm! !
!EastLine methodsFor: 'testing'!
horizontal
^true!
vertical
^false! !
!EastLine methodsFor: 'box crossing'!
crossesBox: aDataFlowBox
"Return true if this EastLine crosses aDataFlowBox,
false if not. 'Crosses' means 'stretches across the entire
height or width of aDataFlowBox'."
| startPoint endPoint box |
startPoint _ collectionOfPoints first.
endPoint _ collectionOfPoints second.
box _ aDataFlowBox boundingBox.
^startPoint y > box top and: [startPoint y < box bottom and: [startPoint x < box left and: [endPoint x > box right]]]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EastLine class
instanceVariableNames: ''!
!EastLine class methodsFor: 'instance creation'!
from: sourcePoint to: destPoint withForm: aForm
"create an instance of EastLine and initialize it"
| anEastLine |
sourcePoint x > destPoint x
ifTrue: [self error: 'line created with incorrect points'].
anEastLine _ super new.
anEastLine
from: sourcePoint
to: destPoint
withForm: aForm.
^anEastLine! !
FoibleLine subclass: #NorthLine
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
!NorthLine methodsFor: 'form access'!
formFor: aLink
"return the form representing the receiver's image"
| aForm compensate |
compensate _ aLink class width // 2.
aForm _ Form extent: aLink class width @ (self beginPoint y - self endPoint y) asInteger.
aLink class northForm
displayOn: aForm
at: aForm offset
clippingBox: aForm boundingBox
rule: Form over
mask: nil.
aForm offset: self endPoint x - compensate @ self endPoint y.
^aForm! !
!NorthLine methodsFor: 'testing'!
horizontal
^false!
vertical
^true! !
!NorthLine methodsFor: 'box crossing'!
crossesBox: aDataFlowBox
"Return true if this NorthLine crosses aDataFlowBox,
false if not. 'Crosses' means 'stretches across the entire
height or width of aDataFlowBox'."
| startPoint endPoint box |
startPoint _ collectionOfPoints first.
endPoint _ collectionOfPoints second.
box _ aDataFlowBox boundingBox.
^startPoint x > box left and: [startPoint x < box right and: [startPoint y > box bottom and: [endPoint y < box top]]]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
NorthLine class
instanceVariableNames: ''!
!NorthLine class methodsFor: 'instance creation'!
from: sourcePoint to: destPoint withForm: aForm
"create an instance of NorthLine and initialize it"
| aNorthLine |
sourcePoint y < destPoint y
ifTrue: [self error: 'line created with incorrect points'].
aNorthLine _ super new.
aNorthLine
from: sourcePoint
to: destPoint
withForm: aForm.
^aNorthLine! !
FoibleLine subclass: #SouthLine
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
!SouthLine methodsFor: 'form access'!
formFor: aLink
"return the form representing the receiver's image"
| aForm compensate |
compensate _ aLink class width // 2.
aForm _ Form extent: aLink class width @ (self endPoint y - self beginPoint y) asInteger.
aLink class southForm
displayOn: aForm
at: aForm offset
clippingBox: aForm boundingBox
rule: Form over
mask: nil.
aForm offset: self beginPoint x - compensate @ self beginPoint y.
^aForm! !
!SouthLine methodsFor: 'testing'!
horizontal
^false!
vertical
^true! !
!SouthLine methodsFor: 'box crossing'!
crossesBox: aDataFlowBox
"Return true if this SouthLine crosses aDataFlowBox,
false if not. 'Crosses' means 'stretches across the entire
height or width of aDataFlowBox'."
| startPoint endPoint box |
startPoint _ collectionOfPoints first.
endPoint _ collectionOfPoints second.
box _ aDataFlowBox boundingBox.
^startPoint x > box left and: [startPoint x < box right and: [startPoint y < box top and: [endPoint y > box bottom]]]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SouthLine class
instanceVariableNames: ''!
!SouthLine class methodsFor: 'instance creation'!
from: sourcePoint to: destPoint withForm: aForm
"create an instance of SouthLine and initialize it"
| aSouthLine |
sourcePoint y > destPoint y
ifTrue: [self error: 'line created with incorrect points'].
aSouthLine _ super new.
aSouthLine
from: sourcePoint
to: destPoint
withForm: aForm.
^aSouthLine! !
FoibleLine subclass: #WestLine
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
!WestLine methodsFor: 'form access'!
formFor: aLink
"return the form representing the receiver's image"
| aForm compensate |
compensate _ aLink class width // 2.
aForm _ Form extent: (self beginPoint x - self endPoint x) asInteger @ aLink class width.
aLink class westForm
displayOn: aForm
at: aForm offset
clippingBox: aForm boundingBox
rule: Form over
mask: nil.
aForm offset: self endPoint x @ (self endPoint y - compensate).
^aForm! !
!WestLine methodsFor: 'testing'!
horizontal
^true!
vertical
^false! !
!WestLine methodsFor: 'box crossing'!
crossesBox: aDataFlowBox
"Return true if this WestLine crosses aDataFlowBox,
false if not. 'Crosses' means 'stretches across the entire
height or width of aDataFlowBox'."
| startPoint endPoint box |
startPoint _ collectionOfPoints first.
endPoint _ collectionOfPoints second.
box _ aDataFlowBox boundingBox.
^startPoint y > box top and: [startPoint y < box bottom and: [startPoint x > box right and: [endPoint x < box left]]]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
WestLine class
instanceVariableNames: ''!
!WestLine class methodsFor: 'instance creation'!
from: sourcePoint to: destPoint withForm: aForm
"create an instance of WestLine and initialize it"
| aWestLine |
sourcePoint x < destPoint x
ifTrue: [self error: 'line created with incorrect points'].
aWestLine _ super new.
aWestLine
from: sourcePoint
to: destPoint
withForm: aForm.
^aWestLine! !
Object subclass: #FoibleDirectory
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleDirectory class
instanceVariableNames: ''!
!FoibleDirectory class methodsFor: 'form access'!
iconDirectory
"return the directory that contains the icons for NullTool and FoibleLink"
^'/jindrich/icons'! !
Object subclass: #FoibleProgram
instanceVariableNames: 'name managers '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
FoibleProgram comment:
'I am the top-level model (in the model-view-controller triad) for any
visual program or environment written using Foible code.
Instance variables:
name <String>
name is displayed in the title bar of the window, and is also used as
the default filename when I am going to be stored.
managers <OrderedCollection>
a collection of the top-level FoibleManagers. there is one top-level
FoibleManager for each canvas in an application.'!
!FoibleProgram methodsFor: 'changes'!
changeRequest
"return whether we need an update, i.e. request confirmation from a
user when a layout is about to be closed"
(self confirm: 'Save this layout before closing?')
ifTrue: [self storeBinary. ^true]
ifFalse: [^true]! !
!FoibleProgram methodsFor: 'accessing'!
firstManager
^managers first!
managerBoxes
| boundingBoxes |
boundingBoxes _ managers collect: [:aMgr | aMgr boundingBox].
^boundingBoxes!
name
^name!
name: aName
name _ aName!
secondManager
^managers at: 2! !
!FoibleProgram methodsFor: 'initialize'!
initialize: aFoibleManager
"Initialize the 'managers' instance variable of this new instance to
be a FoibleManager"
managers _ OrderedCollection with: aFoibleManager.
aFoibleManager program: self.
self name: 'New Layout'!
initUsing: FoibleManager1 and: FoibleManager2
"Initialize the 'managers' instance variable of this new instance to
include FoibleManager1 and FoibleManager2"
managers _ OrderedCollection with: FoibleManager1 with: FoibleManager2.
FoibleManager1 program: self.
FoibleManager2 program: self.
self name: 'NEW Layout'! !
!FoibleProgram methodsFor: 'saving'!
storeStructureOnFile: aFileName
self storeBinaryOn: aFileName! !
!FoibleProgram methodsFor: 'public binary storage'!
storeBinary
"Writes a description of the receiver into a file, in a way that allows
the object's structure to be reconstructed from the file's contents."
| fileName |
fileName _ (FileDirectory currentDirectory)
requestFileName: 'Store binary on which file name?'
default: (self name, '.stbin')
version: #any
ifFail: [^nil].
BinaryOutputManager store: self on: fileName! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
FoibleProgram class
instanceVariableNames: ''!
!FoibleProgram class methodsFor: 'instance creation'!
readStructureFromFile: aFileName
"Read from a disk file a saved FoibleProgram whose instance variable
'managers' is initialized to be an OrderedCollection containing
one (or more) FoibleManagers. The FoibleProgram must have been
saved with the binary storage package."
| newFoibleProgram |
newFoibleProgram _ BinaryInputManager readFrom: aFileName.
^newFoibleProgram!
with: aFoibleManager
"Create an instance of a FoibleProgram whose instance variable
'managers' is initialized to be an OrderedCollection containing
one FoibleManager. Other instance creation methods (e.g.
with: with:, etc.) could be installed if a FoibleProgram with multiple
canvasses (and thus multiple FoibleManagers at the top level) is
desired."
| newFoibleProgram |
newFoibleProgram _ self new.
newFoibleProgram initialize: aFoibleManager.
^newFoibleProgram!
with: FoibleManager1 with: FoibleManager2
"Create an instance of a FoibleProgram whose instance variable
'managers' is initialized to be an OrderedCollection containing
FoibleManager1 and FoibleManager2"
| newFoibleProgram |
newFoibleProgram _ self new.
newFoibleProgram initUsing: FoibleManager1 and: FoibleManager2.
^newFoibleProgram! !
Object subclass: #LineSession
instanceVariableNames: 'lineClass stretchLine1 stretchLine2 cursorLoc '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
LineSession comment:
'I am the abstract class of functions that are performed on the form of a
FoibleLink. My subclasses are used to create and edit the FoibleLines that a
FoibleLink''s form consists of. I do not perform the cursor I/O, so the
objects that create instances of me have to perform the cursor I/O and tell
me the location of the cursor.
Instance variables:
lineClass <class>
this holds the class of FoibleLine to create when new lines must be
created. it must either be FoibleLine or a subclass of FoibleLine.
stretchLine1, stretchLine2 <type lineClass>
these lines are displayed on the screen and may be accessed when
the line session has been completed.
cursorLoc <Point>
the last cursor location that I was told. I only modify my lines if I am
told that the cursor is at a location different from cursorLoc. if it is,
then I update my lines, and set cursorLoc to the new location.'!
!LineSession methodsFor: 'line display'!
cursorAt: aPoint displayIn: aView
aPoint = cursorLoc
ifFalse: [
self eraseIn: aView.
cursorLoc _ aPoint.
self redrawAt: aPoint displayIn: aView]!
displayIn: aView
"display my lines in aView"
self xorIn: aView!
eraseIn: aView
"erase my lines in aClippingBox"
self xorIn: aView!
redrawAt: aPoint
self subclassResponsibility!
redrawAt: aPoint displayIn: aView
"calculate the new line positions, given the cursor location, and display the lines"
self redrawAt: aPoint.
self displayIn: aView!
xorIn: aView
self subclassResponsibility! !
!LineSession methodsFor: 'accessing'!
defaultLineClass
"answer the type of line to use"
^lineClass!
defaultLineClass: aClass
"set the type of line to use"
lineClass _ aClass! !
LineSession subclass: #LineDrawingSession
instanceVariableNames: 'line1Horiz '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
LineDrawingSession comment:
'I am used to create links between boxes. After the first segement of a link
is drawn, there are two moveable lines that change according to the cursor
location. I compute, store and display those lines.
Instance variables:
line1Horiz <Boolean>
is true if stretchLine1 should be horizontal, false if it should be
vertical.'!
!LineDrawingSession methodsFor: 'line display'!
redrawAt: aPoint
"calculate the new line positions, given the cursor location"
| endpt |
line1Horiz
ifTrue: [endpt _ (aPoint x)@(stretchLine1 endPoint y)]
ifFalse: [endpt _ (stretchLine1 endPoint x)@(aPoint y)].
stretchLine1 _ self defaultLineClass from: stretchLine1 beginPoint to: endpt.
stretchLine2 _ self defaultLineClass from: stretchLine1 endPoint to: aPoint!
xorIn: aView
"xor my lines in aView"
stretchLine1 xorInClippingBox: aView insetDisplayBox.
stretchLine2 xorInClippingBox: aView insetDisplayBox! !
!LineDrawingSession methodsFor: 'accessing'!
lastLine
^stretchLine2! !
!LineDrawingSession methodsFor: 'instance creation'!
firstLine: aLine atCursor: aPoint
cursorLoc _ aPoint shallowCopy.
stretchLine1 _ aLine shallowCopy.
line1Horiz _ stretchLine1 horizontal! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
LineDrawingSession class
instanceVariableNames: ''!
!LineDrawingSession class methodsFor: 'instance creation'!
firstLine: firstLine atCursor: aPoint
| aSession |
aSession _ super new.
aSession defaultLineClass: FoibleLine.
^aSession firstLine: firstLine atCursor: aPoint!
firstLine: firstLine atCursor: aPoint using: aLineClass
| aSession |
aSession _ super new.
aSession defaultLineClass: aLineClass.
^aSession firstLine: firstLine atCursor: aPoint! !
LineSession subclass: #LineEditingSession
instanceVariableNames: 'movingLine cutPoint initialBoundingBox '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
LineEditingSession comment:
'I am the abstract class of editing functions that are performed on the form
of a FoibleLink. My subclasses are used to edit the FoibleLines that a
FoibleLink''s form consists of. In a line editing session one segment of a
FoibleLink''s form is translated, according to the current cursor location.
This is segment is stored in my ''movingLine'' instance variable. The two
segments that are connected to each end of this segment are stretched to
keep a consistent and unbroken link. The lines that stretch are stored in my
instance variables ''stretchLine1'' and ''stretchLine2'', which I inherit from
LineSession.
Instance variables:
movingLine <type lineClass>
see LineSession for description of my ''lineClass'' variable. this is the
line that tranlates when I am told that the cursor has moved.
cutPoint <Point>
this location is used to calculate the lines when the cursor moves.
initialBoundingBox <Rectangle>
stores the boundingBox of all of the lines that I am going to edit.
this Rectangle is then merged with the boundingBoxes of the lines
after editing is complete, to give the total area that needs to be
updated on the screen. Also, if the editing session is aborted, then
this area still needs to be updated on the screen.'!
!LineEditingSession methodsFor: 'line display'!
redrawAt: aPoint
"calculate the new line positions, given the cursor location"
((stretchLine1 vertical) & (self movingHoriz) )
ifTrue:[stretchLine1_ self defaultLineClass
from: stretchLine1 beginPoint
to: stretchLine1 beginPoint x @ (aPoint y).
stretchLine2_ self defaultLineClass from: cutPoint x @ (aPoint y) to: cutPoint.]
ifFalse:[stretchLine1_ self defaultLineClass
from: stretchLine1 beginPoint
to: aPoint x @ (stretchLine1 beginPoint y).
stretchLine2_ self defaultLineClass from: aPoint x @ (cutPoint y) to: cutPoint.].
movingLine_ self defaultLineClass from: stretchLine1 endPoint to: stretchLine2 beginPoint.!
xorIn: aView
"xor my lines in aView"
stretchLine1 xorInClippingBox: aView insetDisplayBox.
movingLine xorInClippingBox: aView insetDisplayBox.
stretchLine2 xorInClippingBox: aView insetDisplayBox.! !
!LineEditingSession methodsFor: 'accessing'!
boundingBox
| aRect |
self lines isNil ifTrue: [^nil].
aRect _ self lines first relativeRectangle.
self lines do: [:each | aRect _ aRect merge: each relativeRectangle].
^aRect!
initialBoundingBox
^initialBoundingBox!
lines
"return an OrderedCollection of my lines"
| theLines |
theLines_OrderedCollection new.
theLines add: stretchLine1.
theLines add: movingLine.
theLines add: stretchLine2.
^theLines!
movingHoriz
movingLine isNil
ifFalse:[^movingLine horizontal].
^true! !
LineEditingSession subclass: #LineCuttingSession
instanceVariableNames: 'cutLineLeft '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
LineCuttingSession comment:
'I am a line editing function that cuts one segment of a link into two
segments and adds a new segment between them. After the cut is made
the display on the screen is similar to LineMovingSession.
Instance variables:
cutLineLeft <type lineClass>
this is the second segment that is created when a line is cut. the first
segment is stored in ''movingLine'', which is inherited from
LineEditingSession.'!
!LineCuttingSession methodsFor: 'instance creation'!
cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox
cutLine prev isNil ifTrue: [self error: 'cannot cut this line'].
cursorLoc _ aPoint.
stretchLine1 _ cutLine prev.
cutLine vertical
ifTrue:[cutPoint_cutLine endPoint x @ aPoint y]
ifFalse:[cutPoint_aPoint x @ cutLine endPoint y].
cutPoint_cutPoint.
cutLineLeft_ self defaultLineClass from: cutPoint to: cutLine endPoint.
cutLineLeft xorInClippingBox: aClippingBox.
initialBoundingBox _ cutLine prev relativeRectangle merge: cutLine relativeRectangle! !
!LineCuttingSession methodsFor: 'accessing'!
lines
"return an OrderedCollection of my lines"
| theLines |
theLines_OrderedCollection new.
theLines add: stretchLine1.
theLines add: movingLine.
theLines add: stretchLine2.
theLines add: cutLineLeft.
^theLines! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
LineCuttingSession class
instanceVariableNames: ''!
!LineCuttingSession class methodsFor: 'instance creation'!
cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox
| aSession |
aSession _ super new.
aSession defaultLineClass: FoibleLine.
^aSession cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox!
cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox using: aLineClass
| aSession |
aSession _ super new.
aSession defaultLineClass: aLineClass.
^aSession cutLine: cutLine atCursor: aPoint clippingBox: aClippingBox! !
LineEditingSession subclass: #LineMovingSession
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
LineMovingSession comment:
'I am a line editing function that moves one segment of a link, while
stretching the segments on either side of it.'!
!LineMovingSession methodsFor: 'instance creation'!
moveLine: aLine atCursor: cursorPoint
aLine prev isNil ifTrue: [self error: 'cannot move this line'].
aLine next isNil ifTrue: [self error: 'cannot move this line'].
cursorLoc _ cursorPoint shallowCopy.
stretchLine1 _ aLine prev shallowCopy.
cutPoint _ aLine next endPoint shallowCopy.
initialBoundingBox _ aLine prev relativeRectangle
merge: (aLine relativeRectangle merge: aLine next relativeRectangle)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
LineMovingSession class
instanceVariableNames: ''!
!LineMovingSession class methodsFor: 'instance creation'!
moveLine: aLine atCursor: aPoint
| aSession |
aSession _ super new.
aSession defaultLineClass: FoibleLine.
^aSession moveLine: aLine atCursor: aPoint!
moveLine: aLine atCursor: aPoint using: aLineClass
| aSession |
aSession _ super new.
aSession defaultLineClass: aLineClass.
^aSession moveLine: aLine atCursor: aPoint! !
Object subclass: #Port
instanceVariableNames: 'boundingBox link box '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
Port comment:
'I am the class that represents one possible way of which links are
connected to boxes. Ports can be thought of as the pins on a chip, while
FoibleLinks are the wires between chips.
Instance variables:
boundingBox <Rectangle>
the area on a box that I am associated with.
link <FoibleLink>
the link that is connected to me.
box <FoibleBox>
the box that I am associated with.
'!
!Port methodsFor: 'accessing'!
boundingBox
"return value of the receiver's bounding box"
^Rectangle origin: boundingBox origin + self box offset extent: boundingBox extent!
boundingBox: aRectangle
"set value of the receiver's bounding box"
boundingBox _ aRectangle!
box
"retreive the pointer to the foible box to which this port belongs"
^box!
box: aFoibleBox
"store a pointer to the foible box to which this port belongs"
box _ aFoibleBox!
extent
"return extent of the receiver's bounding box"
^self boundingBox extent!
link
"return value of the receiver's link"
^link!
link: aLink
"set value of the receiver's link"
link _ aLink!
name
"return name of the receiver's foible box"
^self box name!
offset
"return offset of the receiver's bounding box"
^self boundingBox origin! !
!Port methodsFor: 'adding'!
addLink: aBoxLink
"set the receiver's link to be aBoxLink and send the
message on to the receiver's box"
link _ aBoxLink.
(box isKindOf: BoxWithDirectLinks)
ifTrue: [box addLink: aBoxLink]! !
!Port methodsFor: 'removing'!
removeLink: aBoxLink
"remove aBoxLink from the set of links belonging to the receiver's box as well as setting the receiver's link to nil"
link _ nil.
(box isKindOf: BoxWithDirectLinks)
ifTrue: [box removeLink: aBoxLink]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Port class
instanceVariableNames: ''!
!Port class methodsFor: 'instance creation'!
new: aRectangle
"create a new port with a bounding box of size aRectangle"
| aPort |
aPort _ self new.
aPort boundingBox: aRectangle.
^aPort! !
Port subclass: #InputPort
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
InputPort comment:
'I am the class of Ports that connects with a link that is coming from
another box. So, I accept input from another box. At most, one link can be
connected to me at any time.'!
Port subclass: #OutputPort
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
OutputPort comment:
'I am the class of Ports that connects with links that are coming from my
box. I send output to other boxes. There is no limit to the number of links
that can be connected to me at a any time. To allow for this, the ''link''
variable that I inherit from Port is now an OrderedCollection of the links
that are connected to me.'!
!OutputPort methodsFor: 'removing'!
removeLink: aBoxLink
"remove aBoxLink from the set of links belonging to the receiver's
box, as well as setting the receiver's link to nil"
link remove: aBoxLink.
(box isKindOf: BoxWithDirectLinks)
ifTrue: [box removeLink: aBoxLink]! !
!OutputPort methodsFor: 'adding'!
addLink: aBoxLink
"add aBoxLink to the receiver's 'link' instance variable and send the
message on to the receiver's box"
link isNil ifTrue: [link _ OrderedCollection with: aBoxLink]
ifFalse: [link add: aBoxLink].
(box isKindOf: BoxWithDirectLinks)
ifTrue: [box addLink: aBoxLink]! !
Object subclass: #ProtoLink
instanceVariableNames: 'origin destination lines '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
!ProtoLink methodsFor: 'accessing'!
destination
"return the destination of the ProtoLink"
^destination!
destination: toThing
"assign toThing as the destination of the ProtoLink"
destination _ toThing!
lines
"return the ordered collection of lines of the ProtoLink"
^lines!
lines: anOrderedCollection
"assign anOrderedCollection to be the set of lines of the ProtoLink"
lines _ anOrderedCollection!
origin
"return the origin of the ProtoLink"
^origin!
origin: fromThing
"assign fromThing as the origin of the ProtoLink"
origin _ fromThing!
origin: fromThing destination: toThing lines: anOrderedCollection
self origin: fromThing.
self destination: toThing.
self lines: anOrderedCollection! !
Object subclass: #Tool
instanceVariableNames: 'model view controller wantsControl '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
Tool comment:
'My instances perform operations on Foibles in an application.
Instance variables:
model <FoibleManager>
view <CanvasView>
controller <ToolController>
wantsControl <Boolean>'!
!Tool methodsFor: 'initialize'!
initializeWithModel: aModel view: aView controller: aController
self model: aModel.
self view: aView.
self controller: aController.
self startUp.!
startUp
"initialize self"
self installMenu.
self class cursor isNil ifTrue: [self class initialize].
model cursor: self class cursor.
wantsControl _ true! !
!Tool methodsFor: 'menu setup'!
installMenu
controller yellowButtonMenu:
(PopUpMenu labels: 'add
delete
layout'
lines: #(2))
yellowButtonMessages: #(add delete layout).! !
!Tool methodsFor: 'menu messages'!
add
^self subclassResponsibility!
delete
"Find an object and remove it from list, return nil if no find"
| aPoint aThing aRectangle |
aPoint _ self getPoint: (Cursor crossHair offset: -7 @ -9).
aPoint isNil ifTrue: [^nil].
"User aborted"
aThing _ model find: aPoint suchThat: [:it | it canBeDeleted].
aThing isNil ifTrue: [^nil].
"No such object"
(BinaryChoice message: 'Really delete
' , aThing name , '?')
ifFalse: [^nil].
aRectangle _ aThing owner remove: aThing.
model changed: aRectangle.!
getPath
"Allow the user to draw the path between the two boxes
(with appropriate conditions) and return the path"
^self
pathFrom: [:it :point | it givesDataLinks: point]
to: [:it :point | it acceptsDataLinks: point]
width: self defaultLinkClass width
both: [:a :b | a box ~= b box]!
layout
"Allow the user to select layout options - new, old, save"
| string result |
string _ 'create a blank layout
open an old layout'.
model isEmpty ifFalse: [string _ string , '
save this layout'].
result _ (PopUpMenu labels: string) startUp.
result = 0 ifTrue: [^nil].
result = 1 ifTrue: [^(view superView class) open "new window on new FoibleProgram"].
result = 2
ifTrue: [self open]
ifFalse: [self save]!
redButtonActivity
^self! !
!Tool methodsFor: 'private'!
cursor: aPoint inRect: aRect
"Return the proper cursorpoint to keep it in aRect"
| point |
point _ aPoint deepCopy.
(aRect containsPoint: point)
ifFalse: [
point x: ((point x max: ((aRect left) + 5)) min: ((aRect right) - 5)).
point y: ((point y max: ((aRect top) + 5)) min: ((aRect bottom) - 5)).
Sensor cursorPoint: point.
].
^point!
cursorInRect: aRect
"Return the proper cursorpoint to keep it in aRect"
^self cursor: Sensor cursorPoint inRect: aRect!
cursorInView: aView linkWidth: width
"Return a point in aView's coordinates"
^ aView inverseDisplayTransform: (self cursor: Sensor cursorPoint inRect: (self insetView: aView byWidth: width))!
getPoint
"Get a point in the viewport and return its value, nil if left the viewport,
using crosshair cursor"
^self getPoint: Cursor crossHair!
getPoint: aCursor
"Get a point in the viewport and return its value, nil if left the viewport"
| aPoint |
aCursor show.
[ Sensor noButtonPressed & controller isControlActive ]
whileTrue: [aPoint _ Sensor cursorPoint].
model cursor show.
controller isControlActive ifFalse: [^nil].
^(view inverseDisplayTransform: (Sensor waitClickButton)) rounded!
getThingArea: aDisplayObject
"Get a point in the viewport valid for aDisplayObject.
aDisplayObject is only allowed to move around so that its
whole area is totally within the viewport at all times.
Return a rectangle which represents the area of
aDisplayObject, but return nil if have left the viewport."
| aPoint viewRect |
viewRect _ view insetDisplayBox deepCopy.
viewRect _ Rectangle origin: viewRect origin extent: viewRect extent - aDisplayObject extent.
Cursor blank showWhile: [aDisplayObject follow: [self cursorInRect: viewRect]
while: [Sensor noButtonPressed]].
Sensor redButtonPressed
ifFalse:
[Sensor waitClickButton. "Keep other menus from popping up"
^nil].
aPoint _ (view inverseDisplayTransform: Sensor waitClickButton) rounded.
Sensor cursorPoint: Sensor cursorPoint + aDisplayObject computeBoundingBox center.
^aPoint extent: aDisplayObject boundingBox extent!
getThingPoint: aDisplayObject
"Get a point in the viewport valid for aDisplayObject totally
within the viewport. Return its value, nil if left the viewport"
| aPoint viewRect |
viewRect _ view insetDisplayBox deepCopy.
viewRect _ Rectangle origin: viewRect origin
extent: (viewRect extent) - (aDisplayObject extent).
Cursor blank showWhile: [aDisplayObject
follow: [self cursorInRect: viewRect]
while: [Sensor noButtonPressed]].
(Sensor redButtonPressed)
ifFalse: [
Sensor waitClickButton. "Keep other menus from popping up"
^nil].
aPoint _ (view inverseDisplayTransform: Sensor waitClickButton) rounded.
Sensor cursorPoint: Sensor cursorPoint +
aDisplayObject computeBoundingBox center.
^aPoint!
insetView: aView byWidth: width
^(aView insetDisplayBox deepCopy) insetBy: ((width // 2) + 1)! !
!Tool methodsFor: 'access'!
controller: aController
controller _ aController.!
defaultLineClass
"answer the type of line to use"
^FoibleLine!
defaultLinkClass
"answer the type of link to use"
^FoibleLink!
model: aModel
model _ aModel.!
program
^ model program!
view: aView
view _ aView.! !
!Tool methodsFor: 'control defaults'!
isControlActive
^wantsControl! !
!Tool methodsFor: 'basic control sequence'!
controlInitialize
wantsControl _ true.!
controlTerminate
wantsControl _ true.! !
!Tool methodsFor: 'line creation-modification'!
eraseNewPath: theLines in: aClippingBox
| lines |
(theLines size > 2) "get rid of displayed lines"
ifTrue: [lines _ theLines deepCopy.
lines removeLast.
lines removeLast.
lines do: [:each | each xorInClippingBox: aClippingBox]].!
fixLastLine: theLines toBox: aBox
| aLine |
aLine _ theLines last.
theLines removeLast. "may end in middle of box, so fix it"
aLine _ self lineToBox: aBox from: (aLine beginPoint).
theLines addLast: aLine.
^theLines!
getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition
"allow the user to select the ending point of a link"
| toThing destination |
toThing _ model find: aLine endPoint suchThatTwo: toCondition.
toThing isNil
ifTrue: [^nil].
toThing hasPorts
ifTrue: [destination _ toThing findInputPort: aLine endPoint]
ifFalse: [destination _ toThing].
(bothCondition value: destination value: source)
ifFalse: [destination _ nil].
"They do not fit together"
^destination!
getStartingPoint: fromCondition
"let the user choose the starting location of the path of a link
if the chosen box is a BoxWithPorts, then try to find an available port to return,
if the chosen box is a BoxWithDirectLinks, then just return the entire box"
| aPoint fromFoibleBox source |
aPoint _ self getPoint: (Cursor crossHair offset: -7 @ -7).
aPoint isNil ifTrue: [^nil].
fromFoibleBox _ model find: aPoint suchThatTwo: fromCondition.
fromFoibleBox isNil ifTrue: [^nil].
fromFoibleBox hasPorts
ifTrue: [source _ fromFoibleBox findOutputPort: aPoint]
ifFalse: [source _ fromFoibleBox].
^source!
lineFromBox: aFoibleBox to: point
" Make a straight line out of the given FoibleBox to point,
absolute coordinates"
| big beginPoint flowRect deltaLeft deltaRight deltaTop deltaBottom |
flowRect _ aFoibleBox boundingBox.
deltaLeft _ (flowRect left) - (point x).
deltaRight _ (point x) - (flowRect right).
deltaTop _ (flowRect top) - (point y).
deltaBottom _ (point y) - (flowRect bottom).
big _ (deltaLeft max: deltaRight) max: (deltaTop max: deltaBottom).
big = deltaLeft
ifTrue: [beginPoint _ (flowRect left) @
((point y min: flowRect bottom) max: flowRect top).
point y: beginPoint y]
ifFalse: [big = deltaRight
ifTrue: [beginPoint _ (flowRect right)@
((point y min: flowRect bottom) max: flowRect top).
point y: beginPoint y]
ifFalse: [big = deltaTop
ifTrue: [beginPoint _ "big = deltaTop"
((point x min: flowRect right) max: flowRect left)@
(flowRect top).
point x: beginPoint x]
ifFalse: [beginPoint _ "big = deltaBottom"
((point x min: flowRect right) max: flowRect left)@
(flowRect bottom).
point x: beginPoint x]]].
(flowRect containsPoint: point)
ifTrue: [^self defaultLineClass from: beginPoint to: beginPoint]
ifFalse: [^self defaultLineClass from: beginPoint to: point].!
lineFromBox: aFoibleBox to: point displayIn: aClippingBox
"Make a straight line out of the given FoibleBox to point, absolute coordinates,
and display it"
| aFoibleLine |
aFoibleLine _ self lineFromBox: aFoibleBox to: point.
aFoibleLine xorInClippingBox: aClippingBox.
^aFoibleLine!
lineOutOfBox: aFoibleBox width: width
" Allow the user to designate a straight line out fo the given FoibleBox,
aware of the eventual line width"
| line point oldPoint |
point _ self cursorInView: view linkWidth: width.
oldPoint _ point.
line _ self lineFromBox: aFoibleBox to: point displayIn: view insetDisplayBox.
[Sensor noButtonPressed] whileTrue:
[point _ self cursorInView: view linkWidth: width.
(point = oldPoint) ifFalse: [
line xorInClippingBox: view insetDisplayBox. "erase"
oldPoint _ point deepCopy.
line _ self lineFromBox: aFoibleBox to: point displayIn: view insetDisplayBox.
]].
point _ self cursorInView: view linkWidth: width.
line xorInClippingBox: view insetDisplayBox. "erase"
(Sensor redButtonPressed)
ifTrue: [line _ self lineFromBox: aFoibleBox to: point]
ifFalse: [line _ nil].
Sensor waitNoButton. "Wait for click - avoid annoying menus"
^line!
lineSession: aSession width: width
" let the user alter the straight lines: aLine gets stretched, a perpendicular line
is maintained to aLine, and a line is stretched from cutPoint to the
perpendicular "
| point |
point _ self cursorInView: view linkWidth: width.
aSession redrawAt: point displayIn: view.
[Sensor noButtonPressed] whileTrue:
[point _ self cursorInView: view linkWidth: width.
aSession cursorAt: point displayIn: view].
point _ self cursorInView: view linkWidth: width.
aSession redrawAt: point displayIn: view.
(Sensor redButtonPressed)
ifFalse: [^nil]. "user aborted"
Sensor waitNoButton. "avoid the click that leads to menus"
^aSession!
lineToBox: aFoibleBox from: point
" Reverse the direction of the line generated by lineFROM...."
| line |
line _ self lineFromBox: aFoibleBox to: point.
^self defaultLineClass from: line endPoint to: line beginPoint!
moveLine: aLink point: aPoint
" allow the user edit aLink"
| point viewRect firstSegment secondSegment session box |
firstSegment_aLink formAtPoint: aPoint.
firstSegment next isNil ifTrue: [^nil].
viewRect _ view insetDisplayBox.
firstSegment formToLineInClippingBox: viewRect.
point _ self getPoint: Cursor currentCursor.
point isNil ifTrue: [^firstSegment displayForm relativeRectangle].
secondSegment _ aLink formAtPoint: point.
firstSegment xorInClippingBox: viewRect.
secondSegment isNil ifTrue: [^firstSegment displayForm relativeRectangle].
(secondSegment=(firstSegment next))
ifTrue: [secondSegment eraseFormInClipBox: viewRect.
session_LineCuttingSession
cutLine: secondSegment
atCursor: point
clippingBox: viewRect
using: self defaultLineClass]
ifFalse:[secondSegment=firstSegment
ifTrue:[(firstSegment prev) isNil
ifTrue: [^firstSegment displayForm relativeRectangle].
firstSegment prev eraseFormInClipBox: viewRect.
firstSegment next eraseFormInClipBox: viewRect.
session_LineMovingSession moveLine: firstSegment
atCursor: point
using: self defaultLineClass]
ifFalse: [^firstSegment displayForm relativeRectangle]].
box _ session initialBoundingBox.
(self lineSession: session width: self defaultLinkClass width) notNil
ifTrue: [aLink replacePathFromLine: secondSegment prev
toLine: firstSegment next
withLines: session lines .
box _ box merge: session boundingBox].
^box!
pathFrom: fromCondition to: toCondition width: width both: bothCondition
"Let the user specify a path from a Foible that satisfies fromCondition
to a Foible that satisfies toCondition while both satisfy
bothCondition, using width to keep in proper boundaries.
Returns a ProtoLink containing the source, the lines that form the
path and the destination."
| source destination aLine lines |
source _ self getStartingPoint: fromCondition.
source isNil ifTrue: [^nil]. "No such FoibleBox"
lines _ OrderedCollection new.
aLine _ self lineOutOfBox: source width: width.
aLine isNil ifTrue: [^nil]. "User aborted"
lines add: aLine.
destination _ self getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition.
[(destination isNil) & (aLine isNil not)]
whileTrue:
[aLine _ lines last deepCopy.
(lines size > 1)
ifTrue: [ (lines before: lines last) xorInClippingBox: view insetDisplayBox. "display fixed line"].
aLine _ self straightLiner: aLine width: width.
aLine isNil
ifTrue: "User aborted"
[lines addLast: lines last deepCopy. "for display removal"]
ifFalse:
[lines last endPoint: aLine beginPoint. "align with new line"
lines addLast: aLine.
destination _ self getEndingPoint: aLine from: source toCondition: toCondition bothCondition: bothCondition]].
self eraseNewPath: lines in: view insetDisplayBox.
((destination isNil) | (aLine isNil))
ifTrue: [^nil]. "Quit or same FoibleBox - abort"
lines _ self fixLastLine: lines toBox: destination.
^ ProtoLink new origin: source destination: destination lines: lines!
straightLiner: oldLine width: width
" Allow the user to designate a line segment, aware of the eventual width of the line"
| point aSession |
point _ self cursorInView: view linkWidth: width.
aSession _ LineDrawingSession firstLine: oldLine atCursor: point using: self defaultLineClass.
aSession redrawAt: point displayIn: view.
[Sensor noButtonPressed] whileTrue:
[point _ self cursorInView: view linkWidth: width.
aSession cursorAt: point displayIn: view].
aSession redrawAt: point displayIn: view.
(Sensor redButtonPressed)
ifFalse: [^nil].
Sensor waitNoButton. "avoid the click that leads to menus"
^aSession lastLine! !
!Tool methodsFor: 'layout messages'!
open
"Ask for a filename, and make the model the result of reading
the structure in that file"
| aName aFoibleProgram |
aName _ (FillInTheBlank request: 'Open what layout file?') asFileName.
(aName = '') ifTrue: [^nil].
(TekSystemCall existingName: aName)
ifFalse:[^PopUpNotifier message: aName, ' does not exist.'].
Cursor wait show.
aFoibleProgram _ FoibleProgram readStructureFromFile: aName.
model cursor show.
(view superView class) openOn: aFoibleProgram.!
save
"Ask for a filename, and save the model in that file"
| aName stream result |
aName _ (FillInTheBlank request: 'Save in what file?' initialAnswer: (self program name,'.stbin') asFileName) asFileName.
aName = '' ifTrue: [^nil].
(TekSystemCall existingName: aName)
ifTrue:
[result _ BinaryChoice message: 'File ' , aName , ' already exists.
Do you want to overwrite it?'.
result ifFalse: [^nil]].
Cursor wait show.
self program storeStructureOnFile: aName.
model cursor show! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Tool class
instanceVariableNames: 'toolCursor icon '!
Tool class comment:
'Class instance varibles:
- toolCursor - cursor to be displayed when this tool is activated.
- icon - icon to be displayed (in palette of icons on left side of layout
window) when this tool is activated. A tool is activated by
selecting its icon from the palette of icons.'!
!Tool class methodsFor: 'class initialization'!
initialize
"Tool initialize"
toolCursor _ Cursor normal.!
initializeForms
" send this class method when the form for my icon or cursor has been changed "
" <class name> initializeForms "
icon _ self getIcon.
toolCursor _ self getCursor offset: self cursorOffset! !
!Tool class methodsFor: 'form access'!
getCursor
"ask IconManager to get the form for my cursor"
^ self getCursor: self name,'.cur'!
getCursor: iconName
"ask IconManager to get the cursor with name aName"
^ IconManager getCursor: iconName fromDirectory: self iconDirectory!
getIcon
"ask IconManager to get the form for my icon"
^ self getIcon: self name,'.icn'!
getIcon: iconName
"ask IconManager to get the icon with name aName"
^ IconManager getIcon: iconName fromDirectory: self iconDirectory!
iconDirectory
"return the directory that contains the icons for my icon"
self subclassResponsibility! !
!Tool class methodsFor: 'accessing'!
cursor
"Return toolCursor"
toolCursor isNil ifTrue: [toolCursor _ self getCursor offset: self cursorOffset].
^toolCursor!
cursorOffset
"Return the offset of my cursor"
^0@0!
icon
" return Tool's icon for the palette"
icon isNil ifTrue: [icon _ self getIcon].
^icon! !
Tool initialize!
Tool subclass: #NullTool
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
NullTool comment:
'I am the concrete class for Tools that do nothing. I serve as a
placeholder in a canvas.'!
!NullTool methodsFor: 'menu setup'!
installMenu
"Install our menu"
controller yellowButtonMenu: nil
yellowButtonMessages: nil! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
NullTool class
instanceVariableNames: ''!
!NullTool class methodsFor: 'form access'!
iconDirectory
"return the directory that contains the icons for FlowKit"
^FoibleDirectory iconDirectory! !
View subclass: #CanvasView
instanceVariableNames: 'tools '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
CanvasView comment:
'I am the View of a canvas in a visual program. I can update the entire
canvas area, or just a specified area.
Instance Variables:
tools <OrderedCollection>
a collection of Tools. when a new tool is selected from the Palette,
my ToolBenchView tells me which Tool in the collection to install,
and I tell my controller to install it.'!
!CanvasView methodsFor: 'displaying'!
displayView
"Subclasses should redefine View|displayView in order to
display particular objects associated with the View such as
labels, lines, boxes, etc."
^self displayViewClippingBox: self insetDisplayBox!
displayViewClippingBox: aRect
"Display the portion of the model that is within the rectangle"
self clearInside: Form white rect: aRect.
^model
displayOn: Display
at: self insetDisplayBox origin
clippingBox: aRect!
displayViewClippingBoxNoRefresh: aRect
"Display the portion of the model that is within the rectangle
without clearing first. (Needed for smooth redisplay of
graphic i/o boxes.)"
^model
displayOn: Display
at: self insetDisplayBox origin
clippingBox: aRect! !
!CanvasView methodsFor: 'updating'!
update: aRect
"We always update a region of the screen."
aRect class == Rectangle ifFalse: [^self error: 'not a rectangle'].
^self displayViewClippingBox: (aRect translateBy: self insetDisplayBox origin)!
update: aParm with: aRect
"always update a region of the screen. If aParm is a symbol,
update without refresh. Otherwise, use standard update."
aParm == #value
ifTrue:
[aRect class == Rectangle ifFalse: [^self error: 'not a rectangle'].
^self displayViewClippingBoxNoRefresh:
(aRect translateBy: self insetDisplayBox origin)]
ifFalse: [self update: aParm]! !
!CanvasView methodsFor: 'clearing'!
clearInside: aColor rect: aRectangle
"Use aColor to paint the region aRectangle of the receiver."
aColor ~= nil ifTrue: [Display fill: aRectangle mask: aColor]! !
!CanvasView methodsFor: 'initialize'!
initialize
tools _ OrderedCollection new.
super initialize! !
!CanvasView methodsFor: 'private'!
addTools: toolCollection
toolCollection do:
[:each | tools add: each]!
installTool: toolIndex
" a new tool has been selected from the palette, tell my controller to
install the new tool "
self controller tool: (tools at: toolIndex)!
installToolClass: aClass
" tell my controller to install a tool of aClass"
| aTool |
aTool _ tools detect: [:tool | tool isMemberOf: aClass].
aTool isNil ifTrue: [^nil].
self controller tool: aTool! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
CanvasView class
instanceVariableNames: ''!
!CanvasView class methodsFor: 'instance creation'!
new
| aCanvasView |
aCanvasView _ super new.
aCanvasView initialize.
^aCanvasView! !
StandardSystemView subclass: #FoibleView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
FoibleView comment:
'I am the top-level view (in the model-view-controller triad) for any visual
program or environment written using Foible code. I am needed, because
the top-level View must be a subclass of of SyandardSystemView (to
handle resizing the window, etc.), and ToolBenchView is now a subclass of
View.
An instance of ToolBenchView should be my only subView. Canvases are
subViews of a ToolBenchView.
'!
!FoibleView methodsFor: 'framing'!
resize
"Determine the rectangular area for the receiver, adjusted to the minimum
and maximum sizes."
| aRectangle |
aRectangle _ self getFrame.
aRectangle _ aRectangle origin extent:
((aRectangle extent max: minimumSize) min: maximumSize).
self window: (aRectangle deepCopy moveTo: 0@0) viewport: aRectangle.
self firstSubView window: self window viewport: self window! !
!FoibleView methodsFor: 'label access'!
label: aString style: aTextStyle
"Change the name of the FoibleProgram when the label is changed"
super label: aString style: aTextStyle.
model notNil ifTrue: [self model name: aString]! !
View subclass: #ToolBenchView
instanceVariableNames: 'canvas '
classVariableNames: ''
poolDictionaries: ''
category: 'Foible'!
ToolBenchView comment:
'I am the View that manages the canvases in an application. There is one
canvasView for each canvas. The canvasViews are my subViews.
Instance variables:
canvas <OrderedCollection>
a collection of canvasViews, one for each canvas in an application.'!
!ToolBenchView methodsFor: 'transforming'!
window: aWindow viewport: aViewport
"Set the receiver's window to aWindow, set its viewport to aViewport,
and create a new local transformation for the receiver based on
aWindow and aViewport. The receiver is scaled and translated so that
aWindow, when transformed, coincides with aViewport.
It is used to position a subView's window within some specific region of its superView's area. For example, 'subView window: aRectangle1
viewport: aRectangle2' sets subView's window to aRectangle1, its
viewport to aRectangle2, and its local transformation to one that
transforms aRectangle1 to aRectangle2."
| viewBounds canvasWindow canvasViewPort canvasExtent backViewPort numViews upperLeft |
self window: aWindow.
self setTransformation:
(WindowingTransformation window: aWindow viewport: aViewport).
self getViewport.
canvasExtent _ self window extent.
numViews _ self canvas size.
canvasExtent _ canvasExtent x // numViews @ canvasExtent y.
canvasWindow _ Rectangle origin: 0@0 extent: canvasExtent.
upperLeft _ 0@0.
self canvas do:
[:each |
canvasViewPort _ Rectangle origin: upperLeft extent: canvasExtent.
upperLeft _ canvasViewPort topRight.
each window: canvasWindow viewport: canvasViewPort]! !
!ToolBenchView methodsFor: 'initialize'!
initializeWithModel: aFoibleProgram
"Add the sub-view: the variable sized canvas (with a dummy form for now)"
self model: aFoibleProgram.
canvas _ OrderedCollection with: ((CanvasView new model: aFoibleProgram firstManager)
borderWidth: 1).
self addSubView: canvas first! !
!ToolBenchView methodsFor: 'private'!
canvas
"Return the 'canvas' subviews"
^self subclassResponsibility!
installCanvasTools
^self subclassResponsibility!
installTool: toolIndex
" tell each of my canvases to install the new Tool"
1 to: self canvas size do:
[:each | (self canvas at: each) installTool: toolIndex]!
tools
"return an OrderdCollection of the icons for the palette"
^self subclassResponsibility! !
!ToolBenchView methodsFor: 'controller access'!
canvasController
"Return the controllers for the canvas"
^self canvas collect: [:each | each controller]!
canvasController: aBlock
"Set up the controllers for the canvas by evaluating aBlock"
1 to: self canvas size do: [:each | (self canvas at: each)
controller: aBlock value]!
defaultControllerClass
^PaletteController! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ToolBenchView class
instanceVariableNames: ''!
!ToolBenchView class methodsFor: 'instance creation'!
model: aCollectionOfModels
"Create an instance of me that uses aCollectionOfModels as the canvases models"
| view |
view _ super new.
view initializeWithModel: aCollectionOfModels.
^view!
open
"Create a new FoibleProgram and open a ToolBenchView on it"
self openOn: (FoibleProgram with: FoibleManager new)!
openOn: aFoibleProgram
"Create and install views of aFoibleProgram and their menu."
| toolBenchView topView |
toolBenchView _ self model: aFoibleProgram.
toolBenchView canvasController: [CanvasController new].
toolBenchView insideColor: Form gray.
toolBenchView installCanvasTools.
topView _ FoibleView new
model: aFoibleProgram;
label: aFoibleProgram name;
addSubView: toolBenchView in: (0@0 extent: 1@1) borderWidth: 0.
topView minimumSize: 200@400.
topView controller open!
openProgram
"Open an existing program; saved as a binary"
"ToolBenchView openProgram."
| aFileName |
aFileName _ (FileDirectory currentDirectory)
requestFileName: 'Which layout do you want to open?'
default: '*.stbin'
version: #any
ifFail: [^nil].
(TekSystemCall existingName: aFileName)
ifFalse: [^PopUpNotifier message: aFileName , ' does not exist.'].
self openOn: (FoibleProgram readStructureFromFile: aFileName)!
openProgram: aName
"Open an existing program saved as a binary"
"ToolBenchView openProgram: <aName>."
| aFileName |
aFileName _ aName asFileName.
(TekSystemCall existingName: aFileName)
ifFalse: [^PopUpNotifier message: aFileName , ' does not exist.'].
self openOn: (FoibleProgram readStructureFromFile: aFileName)! !